00010	BEGIN "PITCH"
00020	DEFINE ⊂="COMMENT"; ⊂ AUG.2,1973;
00030	INTEGER I,J,K,L,M,N,P,Q,R,POINTX,POINTY,STATE,DELTA,VAL,CHAN1,EOF;
00040	INTEGER II,JJ,P1,P2,P3,T1,T2,T3,T,DT,H,TAU1,TAU2;
00050	INTEGER ARRAY BUF,PITCH[0:1000];
00060	STRING FILEN,READ,READ1,FILEO,READ2;
00070	DEFINE CR="'15",LF="'12",TB="'11",CRLF="CR&LF";
00100	
00110	⊂ Three peaks are located, then tests are made on the middle
00120	   one to determine whether it should be reported or discarded;
00130	⊂ These peaks are P1, P2, and P3 with corresponding times of T1, T2 and T3;
00140	
00150	⊂ The conditions for discarding are
00160	    a) just getting started, P1=0
00170	   b) the middle peak is definitely smaller than one at the ends
00180	   c) the time interval between P1 and P2 is too small;
00190	
00200	FILEN←"FLTD.001[DAT,NJM]";
00210	OUTSTR("Type file name (CR for "&FILEN&".");
00220	IF (READ←INCHWL)≠"" THEN FILEN←READ ELSE READ←FILEN;
00230	  READ1←""; FOR I←0 STEP 1 UNTIL 6 DO BEGIN
00240	  READ2←READ[1 TO 1]; READ1←READ1&READ2; READ←READ[2 TO 6];
00250	  IF READ2="." THEN DONE; END;
00260	  FILEO←READ1&"PCH";
00270	  POINTY←POINT(12,PITCH[0],-1);
00280	TAU1←30;
00290	OUTSTR("Set TAU1 (CR for 30) ");IF (READ←INCHWL)≠"" THEN TAU1←CVD(READ);
00300	TAU2←140;
00310	OUTSTR("Set TAU2 (CR for 140) ");IF (READ←INCHWL)≠"" THEN TAU2←CVD(READ);
00320	DELTA←20000;
00330	OUTSTR("Type value for DELTA (CR for 20000) ");
00340	IF (READ←INCHWL)≠"" THEN DELTA←CVD(READ);
00350	CHAN1←1; CLOSE(CHAN1); OPEN(CHAN1,"DSK",'10,10,0,0,0,EOF);
00360	LOOKUP(CHAN1,FILEN,0);
00370	J←K←L←STATE←VAL←R←0;
00380	OUTSTR(CRLF&"Pitch  measure on file "&FILEN &CRLF&LF);
00385	OUTSTR("   T   P   A      T   P   A      T   P   A      T   P   A"&CRLF&LF);
00390	SETFORMAT(4,0); P←P1←P2←P3←T1←T2←T3←H←Q←0;
00400	WHILE EOF=0 DO BEGIN
00410	  FOR J←0 STEP 1 UNTIL 1000 DO BUF[J]←0;
00420	  ARRYIN(CHAN1,BUF[0],1000);
00430	  POINTX←POINT(12,BUF[0],-1);
00440	FOR I←0 STEP 1 UNTIL 2999 DO BEGIN
00450	    L←K*1500+I%2;
00460	    VAL←ILDB(POINTX); IF VAL>2047 THEN VAL←VAL-4096;
00470	
00480	
00490	IF VAL>0 THEN IF H≤0 THEN BEGIN
00500	⊂  OUTSTR(CRLF&CVS(L)&"  P's "&CVS(P1)&CVS(P2)&CVS(P3)&CVS(P)&"   T's "
00510	       &CVS(T1%100)&CVS(T2-T1)&CVS(L-T2)&"   ");
00520	  WHILE TRUE DO BEGIN
00530	
00540	    IF P1<DELTA THEN BEGIN
00550	⊂ OUTSTR("P1<DELTA");
00560	      P1←P2; T1←T2; P2←P; T2←L; DONE END;
00570	
00580	    IF T2-T1>TAU2 THEN BEGIN
00590	⊂ OUTSTR("T2-T1>TAU2");
00600	       P1←P2; T1←T2; P2←P; T2←L; DONE END;
00610	
00620	    IF P2<DELTA THEN BEGIN
00630	⊂ OUTSTR("P2<DELTA");
00640	      P2←P; T2←L; DONE END;
00650	
00660	    IF P<P3 THEN BEGIN
00670	⊂ OUTSTR("P<P3");
00680	      DONE END;
00690	
00700	    IF T2-T1<TAU1 THEN BEGIN
00710	⊂ OUTSTR("T2-T1<TAU1");
00720	      IF P2>P1 THEN BEGIN
00730	        P1←P2; T1←T2; P2←P; T2←L; DONE END ELSE BEGIN
00740	        P2←P; T2←L; DONE END; END;
00750	
00760	    IF P2<P1 THEN IF P2<P THEN IF L-T1<TAU2 THEN BEGIN
00770	⊂ OUTSTR("P1>P2<P");
00780	      P2←P; T2←L; DONE END;
00790	
00800	⊂ OUTSTR("Ready to report");
00810	    OUTSTR(CVS(T1%10)&CVS(T2-T1)&CVS(P1 LSH -18)&"   ");
00820	    IF (R MOD 4)=3 THEN BEGIN OUTSTR(CRLF); R←0; END ELSE R←R+1;
00830	    TAU1←(TAU1+2*(T2-T1)) LSH -2;
00835	    IF TAU1<30 THEN TAU1←30;
00840	    TAU2←(2*TAU2+3*(T2-T1)) LSH -2;
00845	    IF TAU2>140 THEN TAU2←140;
00850	    Q←Q+1;
00860	    IDPB(T1%100,POINTY); IDPB(T2-T1,POINTY); IDPB((P1 LSH -9),POINTY);
00870	    P1←P2; T1←T2; P2←P; T2←L; DONE END;
00880	  P3←P; P←0; END;
00890	H←VAL;
00900	P←P+VAL*VAL;
00910	
00920	  END;
00930	K←K+1;
00940	
00950	END;
00960	
00970	CLOSE(CHAN1); OPEN(CHAN1,"DSK",'10,0,10,0,0,0);
00980	ENTER(CHAN1,FILEO,0);
00990	ARRYOUT(CHAN1,PITCH[0],Q); RELEASE(CHAN1);
01000	END "PITCH";